home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0921.ZIP / QWIK40.ARC / QBENCH.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-01  |  8KB  |  270 lines
  1. { Qbench.pas - produces a 'Screens/second' table for        ver 4.0, 12-01-87 }
  2. {              QWIK Screen utilities.                                         }
  3. { I'm not trying to support this program, so don't expect it to be perfect.
  4.   It will just give you a good feel for speed.  The time is adjusted for
  5.   an average 8 second test for each condition - total of 112 seconds.  For
  6.   more accurate results, change TestTime:=16.  Or for a quicker but less
  7.   accurate test, change TestTime:=1. }
  8.  
  9. uses Crt, {$U Qwik40.tpu} Qwik;
  10. {$i timerd12.inc}
  11.  
  12. type
  13.   Attrs = (Attr,NoAttr);
  14.  
  15. const
  16.   Procs = 9;
  17.   TestTime = 8;  { TestTime in seconds for each case.  8 gives +/- 1% }
  18.  
  19. var
  20.   Attrib, Count, Screens: integer;
  21.   OldCursor:  word;
  22.   Row, Col, Rows, Cols, ProcNumber: byte;
  23.   ScrPerSec: array[1..Procs] of array[Attr..NoAttr] of real;
  24.   Strng:     string[80];
  25.   A:         Attrs;
  26.   ScrArray:  array[1..4000] of byte;
  27.   Names:     array[1..Procs] of string[80];
  28.   FV:        text;
  29.   ToDisk:    boolean;
  30.   Ch:        char;
  31.  
  32. procedure CheckCursor;
  33. var CursorMode: integer absolute $0040:$0060;
  34. begin
  35.   if ActiveDispDev=MdaMono then
  36.     if CursorMode=$0607 then
  37.       CursorChange($0B0C,OldCursor);
  38. end;
  39.  
  40. procedure CheckTime;
  41. begin
  42.   Strng:='TimerTest ';
  43.   for Col:=1 to 3 do Strng:=Strng+Strng;
  44.   Qfill  (1,1,25,80,14,' ');
  45.   timer (start);
  46.   for Count:=1 to Screens do
  47.     for row:=1 to 25 do
  48.       Qwrite (Row,1,14,Strng);
  49.   timer (Stop);
  50.   Screens:=trunc(Screens*TestTime/ElapsedTime);
  51. end;
  52.  
  53. procedure WritesFillsProcedures (ProcNumber: byte);
  54. begin
  55.   case ProcNumber of
  56.     1: begin
  57.          timer (start);
  58.          for Count:=1 to Screens do
  59.            for Row:=1 to 25 do
  60.              Qwrite (Row,1,Attrib,Strng);
  61.          timer (Stop);
  62.        end;
  63.     2: begin
  64.          timer (start);
  65.          for Count:=1 to Screens do
  66.            for Row:=1 to 25 do
  67.              QwriteC (Row,1,80,Attrib,Strng);
  68.          timer (Stop);
  69.        end;
  70.     3: begin
  71.          timer (start);
  72.          for Count:=1 to Screens do
  73.            for Row:=1 to 25 do
  74.              QwriteA (Row,1,Attrib,80,Strng[1]);
  75.          timer (Stop);
  76.        end;
  77.     4: begin
  78.          timer (start);
  79.          for Count:=1 to Screens do
  80.            QfillC (1,1,80,25,80,Attrib,'C');
  81.          timer (Stop);
  82.        end;
  83.     5: begin
  84.          timer (start);
  85.          for Count:=1 to Screens do
  86.            Qfill (1,1,25,80,Attrib,'F');
  87.          timer (Stop);
  88.        end;
  89.      end;  { Case ProcNumber of }
  90.   if Attrib>=0 then
  91.     case ProcNumber of
  92.       6: begin
  93.            Qfill (1,1,25,80,Attrib,'a');
  94.            timer (start);
  95.            for Count:=1 to Screens do
  96.              Qattr (1,1,25,80,Attrib);
  97.            timer (Stop);
  98.          end;
  99.       7: begin
  100.            Qfill (1,1,25,80,Attrib,'c');
  101.            timer (start);
  102.            for Count:=1 to Screens do
  103.              QattrC (1,1,80,25,80,Attrib);
  104.            timer (Stop);
  105.          end;
  106.     end;  { Case ProcNumber of }
  107.   if ElapsedTime<>0.0 then
  108.   ScrPerSec[ProcNumber,A]:=Screens/ElapsedTime;
  109. end;
  110.  
  111. procedure StoresProcedures (ProcNumber: byte);
  112. begin
  113.   for Row:=1 to 25 do
  114.     Qwrite (Row,1,Attrib,Strng);
  115.   case ProcNumber of
  116.     8: begin
  117.          timer (start);
  118.          for Count:=1 to Screens do
  119.            QstoreToMem (1,1,25,80,ScrArray);
  120.          timer (Stop);
  121.        end;
  122.     9: begin
  123.          QstoreToMem (1,1,25,80,ScrArray);
  124.          timer (start);
  125.          for Count:=1 to Screens do
  126.            QstoreToScr (1,1,25,80,ScrArray);
  127.          timer (Stop);
  128.        end;
  129.   end;  { Case ProcNumber of }
  130.   ScrPerSec[ProcNumber,A]:=Screens/ElapsedTime;
  131. end;
  132.  
  133. procedure LoopWritesFills (At: Attrs; Att: integer);
  134. begin
  135.   A:=At;
  136.   Attrib:=Att;
  137.   for ProcNumber:=1 to 7 do
  138.     begin
  139.       Strng:=Names[ProcNumber];
  140.       if Qsnow then
  141.            Strng:=Strng+' Wait    '
  142.       else Strng:=Strng+' No Wait ';
  143.       if A=Attr then
  144.            Strng:=Strng+' w/Attr  '
  145.       else Strng:=Strng+' No Attr ';
  146.       fillchar (Strng[32],49,ProcNumber+48);
  147.       Strng[0]:=#80;
  148.       WritesFillsProcedures (ProcNumber);
  149.     end;
  150. end;
  151.  
  152. procedure LoopStores (At: Attrs; Att: integer);
  153. begin
  154.   A:=At;
  155.   Attrib:=Att;
  156.   for ProcNumber:=8 to 9 do
  157.     begin
  158.       Strng:=Names[ProcNumber];
  159.       if Qsnow then
  160.            Strng:=Strng+' Wait    '
  161.       else Strng:=Strng+' No Wait ';
  162.       Strng:=Strng+' w/Attr  ';
  163.       fillchar (Strng[32],49,ProcNumber+48);
  164.       Strng[0]:=#80;
  165.       StoresProcedures (ProcNumber);
  166.     end;
  167. end;
  168.  
  169. begin
  170.   Qfill  (1,1,25,80,14,' ');
  171.   if Qsnow then
  172.     begin
  173.       Qsnow:=false;
  174.       GotoRC (12,52);
  175.       repeat
  176.         repeat
  177.           QwriteC (12,1,80,-1,'Do you see snow? [Y/N]?');
  178.         until Keypressed;
  179.         Ch:=ReadKey;
  180.       until Ch in ['Y','y','N','n'];
  181.       case upcase(Ch) of
  182.         'Y': Qsnow:=true;
  183.         'N': begin
  184.                QwriteC (10,1,80,-1,'Congratulations!  You have a card better');
  185.                QwriteC (11,1,80,-1,'than the standard IBM CGA.');
  186.                QwriteC (12,1,80,-1,'However, to make it faster, you will need');
  187.                QwriteC (13,1,80,-1,'to set Qsnow:=false manually.');
  188.                QwriteC (14,1,80,-1,'Please contact me about this.');
  189.                QwriteC (16,1,80,-1,'Press any key ...');
  190.                GotoRC  (16,49);
  191.                Ch:=ReadKey;
  192.                if Ch=#00 then Ch:=ReadKey;
  193.              end;
  194.       end;
  195.     end;
  196.   Qfill   (1,1,25,80,14,' ');
  197.   QwriteC (12,1,80,-1,'Data to Screen or Disk [s/d]?');
  198.   GotoRC  (12,55);
  199.   repeat
  200.     Ch:=ReadKey;
  201.   until Ch in ['S','s','D','d',^M];
  202.   if upcase(Ch)='D' then
  203.        ToDisk:=true
  204.   else ToDisk:=false;
  205.   CheckCursor;
  206.   CursorOff;
  207.   Qfill (1,1,1,80,14,' ');
  208.  
  209.   for ProcNumber:=1 to Procs do
  210.     for A:= Attr to NoAttr do
  211.       ScrPerSec[ProcNumber,A]:=0.0;
  212.  
  213.   Names[1]:= ' Qwrite      ';
  214.   Names[2]:= ' QwriteC     ';
  215.   Names[3]:= ' QwriteA     ';
  216.   Names[4]:= ' QfillC      ';
  217.   Names[5]:= ' Qfill       ';
  218.   Names[6]:= ' Qattr       ';
  219.   Names[7]:= ' QattrC      ';
  220.   Names[8]:= ' QstoreToMem ';
  221.   Names[9]:= ' QstoreToScr ';
  222.  
  223.   if Qsnow then
  224.        Screens:=8    { First guess for screens }
  225.   else Screens:=80;  { First guess for screens }
  226.   CheckTime;
  227.   LoopWritesFills (Attr, 14);
  228.   LoopStores      (Attr, 14);
  229.   Qattr           (1,1,25,80,7);
  230.   LoopWritesFills (NoAttr, -1);
  231.  
  232.   Qfill (1,1,25,80,14,' ');
  233.   if ToDisk then
  234.        assign    (FV,'Qbench.dta')
  235.   else assignCRT (FV);
  236.   rewrite (FV);
  237.   GotoRC (1,1);
  238.   writeln (FV,'S C R E E N S / S E C O N D');
  239.   writeln (FV,'             Chng');
  240.   writeln (FV,'Procedure    Attr S/sec');
  241.   writeln (FV,'---------    ---- -----');
  242.   for ProcNumber:=1 to 5 do
  243.   for A:=Attr to NoAttr do
  244.     begin
  245.       if A=Attr then
  246.            write (FV,Names[ProcNumber])
  247.       else write (FV,'             ');
  248.       if A=Attr then
  249.            write (FV,'Yes  ')
  250.       else write (FV,'No   ');
  251.       writeln (FV,ScrPerSec[ProcNumber,A]:5:1);
  252.     end;
  253.   for ProcNumber:=6 to 9 do
  254.     begin
  255.       write (FV,Names[ProcNumber]);
  256.       if ProcNumber<10 then
  257.            write (FV,'Yes  ')
  258.       else write (FV,'n/a  ');
  259.       writeln (FV,ScrPerSec[ProcNumber,Attr]:5:1);
  260.     end;
  261.   GotoRC  (21,1);
  262.   writeln (FV,'SystemID         = ',SystemID);
  263.   writeln (FV,'SubModelID       = ',SubmodelID);
  264.   writeln (FV,'Wait-for-retrace = ',Qsnow);
  265.   writeln (FV,'Screens/test     = ',Screens);
  266.   close   (FV);
  267.   GotoRC  (24,1);
  268.   CursorOn;
  269. end.
  270.